home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
User's Choice Windows CD
/
User's Choice Windows CD (CMS Software)(1993).iso
/
windows4
/
qbnws302.zip
/
HASH.ZIP
/
HASH.BAS
Wrap
BASIC Source File
|
1992-06-20
|
16KB
|
518 lines
' Hashed Access Demonstration Program For The QuickBasic Echo
' By Mike Avery, Started 12-28-91
' Version 1:00.00 - Make it work. 12-28-91
' Version 1:01.00 - Add Disk Functions 12-29-91
' ========================================================================
DECLARE FUNCTION Hash! (TestString$)
DECLARE SUB GetData (Key$, Index%, SeekCount%, SaveIndex%)
DECLARE SUB Waiter ()
DECLARE FUNCTION WhackIt$ (InputString$)
CONST DeletedValue$ = "EXPLETIVE DELETED"
CONST ArraySize% = 531 'Change the size here - the rest adjusts itself
CONST RetryLimit% = 100 'I get bored easily....
CONST ScreenLimit% = 21 'how many lines do we show at once?
CONST True = -1: CONST False = NOT (True)
DIM SHARED A$(ArraySize%, 1) 'our little data base
DIM SHARED SortSpace$(ArraySize%, 1) 'Workspace for sorted lists
PowerMax% = INT((LOG(ArraySize%) / LOG(2)) + 2)
DIM SHARED PowersOfTwo%(PowerMax%)
'build the table - lookup is faster than calculation
FOR I% = 0 TO PowerMax%
PowersOfTwo%(I%) = 2 ^ I%
NEXT I%
DO WHILE TestName$ <> "STOP"
CLS
PRINT "Doofus Phone Book System"
PRINT
PRINT
INPUT "Name/Help/Dump/Sort/Load/Save/Analyse/Stop"; TestName$
TestName$ = UCASE$(RTRIM$(LTRIM$(TestName$)))
IF TestName$ = "DUMP" THEN
GOSUB DumpIt
ELSEIF TestName$ = "SORT" THEN
GOSUB SortIt
ELSEIF TestName$ = "ANALYSE" THEN
GOSUB Analyse
ELSEIF TestName$ = "HELP" THEN
GOSUB Help
ELSEIF TestName$ = "LOAD" THEN
GOSUB LoadIt
ELSEIF TestName$ = "SAVE" THEN
GOSUB SaveIt
ELSEIF TestName$ <> "" AND TestName$ <> "STOP" THEN
CALL GetData(TestName$, Index%, SeekCount%, SaveIndex%)
' At this point, one of 3 conditions exists.
' 1. We ran out of retries, and it doesn't matter what Index% points to,
' 2. Index% points to our data, or
' 3. Index% points to an empty record and SaveIndex may or may not
' point to a deleted record we can reuse.
PRINT
PRINT "It took "; SeekCount%; "tries to determine that..."
'in a productional program, you'd probably drop that message...
PRINT
IF SeekCount% >= RetryLimit% THEN
PRINT "The data base is full and/or needs to be resized"
YesOrNo$ = ""
DO WHILE YesOrNo$ <> "Y" AND YesOrNo$ <> "N"
INPUT "Do you want to see a data base dump (Y/N)"; YesOrNo$
IF YesOrNo$ <> "" THEN
YesOrNo$ = WhackIt$(YesOrNo$)
END IF
IF YesOrNo$ = "Y" THEN
GOSUB DumpIt
ELSEIF YesOrNo$ <> "N" THEN
PRINT "Please Enter A Y for Yes or a N for NO."
END IF
LOOP
TestName$ = "STOP"'force a shutdown
CALL Waiter
' save data base here, if converted to a disk based system
ELSEIF A$(Index%, 0) = TestName$ THEN
PRINT A$(Index%, 0); "'s Phone Number Is "; A$(Index%, 1); "."
Action$ = "Dummy"
DO WHILE Action$ <> "" AND Action$ <> "C" AND Action$ <> "D"
INPUT "Change the number, Delete The Number, or enter"; Action$
IF Action$ <> "" THEN
Action$ = WhackIt$(Action$)
IF Action$ = "C" THEN
'else if we are to change the number
INPUT "New phone number please"; PhoneNumber$
PhoneNumber$ = UCASE$(RTRIM$(LTRIM$(PhoneNumber$)))
IF PhoneNumber$ = "" THEN
PRINT "Number not changed"
ELSE
A$(Index%, 1) = PhoneNumber$
PRINT "Phone number has been updated."
END IF
ELSEIF Action$ = "D" THEN
A$(Index%, 0) = DeletedValue$
PRINT "Entry has been deleted."
ELSE
'an invalid entry was made
PRINT "Please enter a D to Delete the number,"
PRINT "a C to Change it, or"
PRINT "just press Enter to continue."
Action$ = "DUMMY"
END IF
END IF
LOOP
ELSE
PRINT TestName$; "'s Phone Number Is Not On File. You May Enter It To Add"
PRINT "It, Or Just Press "; CHR$(34); "ENTER"; CHR$(34); " To Continue.";
INPUT PhoneNumber$
PhoneNumber$ = UCASE$(RTRIM$(LTRIM$(PhoneNumber$)))
IF PhoneNumber$ <> "" THEN
IF SaveIndex% <> -1 THEN
'reuse delete space
Index% = SaveIndex%
PRINT "We are reclaiming unused space! Ain't it great!"
CALL Waiter
END IF
A$(Index%, 0) = TestName$
A$(Index%, 1) = PhoneNumber$
END IF
END IF
END IF
LOOP
ExitRoutine:
SYSTEM
Analyse:
'process all the data elements in A$ to see:
' how full A$ is,
' best and worst case access to A$,
' mean, SD of access count
' Statistics routines "borrowed" in part from
' "Some Common Basic Programs" pg 121-122
' by Lon Poole and Mary Borchers
' Published by Adam Osborne
' Copyright 1977
' pages 121-123
PRINT "Analysis Begins.... Please Wait....."
Best% = 999
Worst% = 0
S = 0 ' we are dealing with a population, not a sample
N = 0 ' count of active elements
M = 0 ' Sum of X^2
P = 0 ' Sum of X
FOR I% = 0 TO ArraySize%
IF A$(I%, 0) <> "" AND A$(I%, 0) <> DeletedValue$ THEN
CALL GetData(A$(I%, 0), Index%, Tries%, FirstDeleted%)
N = N + 1 ' Bump entry count
P = P + Tries% ' Bump sum of X
M = M + (Tries% ^ 2) ' Bump sum of X^2
IF Tries% < Best% THEN
Best% = Tries%
BestOne% = Index%
END IF
IF Tries% > Worst% THEN
Worst% = Tries%
WorstOne% = Index%
END IF
END IF
NEXT I%
IF N > 0 THEN
PRINT "Access Analysis....."
R = P / N
PRINT "Number Of Entries ="; N
PRINT "Percent Full ="; INT((N / (ArraySize% + 1)) * 100); "%"
PRINT "Average Access ="; R; "Seeks."
V = (M - N * R ^ 2) / (N - S)
SD = SQR(V)
PRINT "Standard Deviation ="; SD
PRINT "Best Access ="; Best%; "Seeks On "; A$(BestOne%, 0); "."
PRINT "Worst Access ="; Worst%; "Seeks On "; A$(WorstOne%, 0); "."
ELSE
PRINT "No Data To Analyze. Sorry."
END IF
CALL Waiter
RETURN
DumpIt:
DisplayControl% = 0
FOR I% = 0 TO ArraySize%
PRINT I%, A$(I%, 0), A$(I%, 1)
DisplayControl% = DisplayControl% + 1
IF DisplayControl% > ScreenLimit% THEN
CALL Waiter
DisplayControl% = 0
END IF
NEXT I%
CALL Waiter
RETURN
ErrorHandler:
PRINT "ErrorHandler Sez...."
IF ERR = 53 OR ERR = 76 OR ERR = 68 OR ERR = 52 OR ERR = 64 OR ERR = 75 THEN
PRINT "A file you wanted to process, "; FileName$
PRINT "Could not be found/created."
Found = False
CALL Waiter
RESUME NEXT
END IF
IF ERR = 61 THEN
PRINT "Sorry, the disk is full."
ELSE
PRINT "You had an Error #"; ERR
END IF
PRINT "Press any key to quit...."
K$ = ""
DO WHILE K$ = ""
K$ = INKEY$
LOOP
RESUME ExitRoutine
Help:
'Display a primitive help screen
CLS
PRINT "Doofus Phone Book System"
PRINT
PRINT
PRINT "Name/Help/Dump/Sort/Load/Save/Analyse/Stop? HELP"
PRINT
PRINT "The Doofus Phone Book System was written as a demonstration of Hashed"
PRINT "Data Access, rather than as a phone book system. If it works for you,"
PRINT "fine, but that was not the author's intent."
PRINT
PRINT "At the first prompt "; CHR$(34); "Name/Help/Dump/Sort/Load/Save/Analyse:"; CHR$(34); ","
PRINT "You may enter a name to be added or looked up in the data base by entering"
PRINT "the name."
PRINT "You may ask for help by entering "; CHR$(34); "HELP"; CHR$(34); "."
PRINT "You may see a raw dump of the data array by entering "; CHR$(34); "DUMP"; CHR$(34); "."
PRINT "You may see a sorted data dump of the array by entering "; CHR$(34); "SORT"; CHR$(34); "."
PRINT "You may load or save the data to/from disk with the LOAD and SAVE commands."
PRINT "You may analyse the data set by entering the command "; CHR$(34); "ANALYSE"; CHR$(34); "."
PRINT "You may exit the application by entering the command "; CHR$(34); "STOP"; CHR$(34); "."
CALL Waiter
CLS
PRINT "Doofus Phone Book System"
PRINT
PRINT
PRINT "Name/Help/Dump/Sort/Load/Save/Analyse/Stop? HELP"
PRINT
PRINT "Once you have called up a phone number entry, you may continue by pressing"
PRINT CHR$(34); "ENTER"; CHR$(34); ", or you may change the data by entering a "; CHR$(34); "C"; CHR$(34); ","
PRINT "or you may delete the data by pressing a "; CHR$(34); "D"; CHR$(34); "."
CALL Waiter
CLS
RETURN
LoadIt:
'load the data from a data file
Free% = 0
Empty% = Empty% + 1
FOR I% = 0 TO ArraySize%
IF A$(I%, 0) = "" THEN
Free% = Free% + 1
Empty% = Empty% + 1
ELSEIF A$(I%, 0) = DeletedValue$ THEN
Free% = Free% + 1
END IF
NEXT I%
IF Empty% = 0 THEN
GOSUB SorryFull
ELSE
INPUT "File To Load From:"; FileName$
ON ERROR GOTO ErrorHandler
Found = True
OPEN FileName$ FOR INPUT AS 1
IF Found = True THEN
DO WHILE NOT EOF(1) AND Free% > 0
INPUT #1, TestName$, PhoneNumber$
CALL GetData(TestName$, Index%, Seeks%, SaveIndex%)
IF SeekCount% >= RetryLimit% THEN
PRINT "The data base is full and/or needs to be resized"
YesOrNo$ = ""
DO WHILE YesOrNo$ <> "Y" AND YesOrNo$ <> "N"
INPUT "Do you want to see a data base dump (Y/N)"; YesOrNo$
IF YesOrNo$ <> "" THEN
YesOrNo$ = WhackIt$(YesOrNo$)
END IF
IF YesOrNo$ = "Y" THEN
GOSUB DumpIt
ELSEIF YesOrNo$ <> "N" THEN
PRINT "Please Enter A Y for Yes or a N for NO."
END IF
LOOP
Free% = 0 'force a shutdown
CALL Waiter
ELSEIF A$(Index%, 0) = TestName$ THEN
' the value is already on file
' we'll just replace the old value for now,
' and keep on truckin - we could ask the user
' what we should do, but not for a test program!
A$(Index%, 1) = PhoneNumber$
PRINT A$(Index%, 0); "has been updated!"
ELSE
IF SaveIndex% <> -1 THEN
'reuse deleted space
Index% = SaveIndex%
PRINT "We are reclaiming unused space! Ain't it great!"
END IF
A$(Index%, 0) = TestName$
A$(Index%, 1) = PhoneNumber$
Free% = Free% - 1
END IF
IF Free% < 1 THEN
PRINT "The data base has been completely filled."
PRINT "Some data was not loaded from the file you selected."
PRINT
GOSUB SorryFull
CALL Waiter
END IF
LOOP
CLOSE 1
END IF
ON ERROR GOTO 0
END IF
RETURN
SaveIt:
'Save data to a selected file
ON ERROR GOTO ErrorHandler
INPUT "Name of file to save data to:"; FileName$
OPEN FileName$ FOR OUTPUT AS 1
FOR I% = 0 TO ArraySize%
IF A$(I%, 0) <> "" AND A$(I%, 0) <> DeletedValue THEN
PRINT #1, A$(I%, 0); ","; A$(I%, 1)
END IF
NEXT I%
CLOSE 1
RETURN
SortIt:
' convert, sort, and dump the data base
'convert the hashed A$() into a packed SortSpace$()
PRINT "Converting the data into a linear array...."
NextEntry% = 0
FOR I% = 0 TO ArraySize%
IF A$(I%, 0) <> "" AND A$(I%, 0) <> DeletedValue$ THEN
SortSpace$(NextEntry%, 0) = A$(I%, 0)
SortSpace$(NextEntry%, 1) = STR$(I%)
'track the location of the data, not the data....
NextEntry% = NextEntry% + 1
END IF
NEXT I%
IF NextEntry% <= 0 THEN
PRINT "No Data Was Found To Display."
ELSE
'now that all the data has been moved from A$() to SortSpace$(), we
'need to sort it. How about an exchange sort?
LastItem% = NextEntry% - 1
IF LastItem% > 1 THEN
PRINT "Sorting"; LastItem% + 1; "items. Please Wait....."
FOR I% = 0 TO LastItem% - 1
Lowest% = I%
FOR J% = I% + 1 TO LastItem%
CompareCount! = CompareCount! + 1
IF SortSpace$(J%, 0) < SortSpace$(Lowest%, 0) THEN
Lowest% = J%
END IF
NEXT J%
IF Lowest% <> I% THEN
SWAP SortSpace$(I%, 0), SortSpace$(Lowest%, 0)
SWAP SortSpace$(I%, 1), SortSpace$(Lowest%, 1)
END IF
NEXT I%
ELSE
PRINT "1 item found, the sort will be skipped this time...."
END IF
'Now the keys are sorted, so let's display the data....
PRINT "Order", "Name", "Phone #", "Place in A$"
DisplayCount% = 0
FOR I% = 0 TO LastItem%
Pointer% = VAL(SortSpace$(I%, 1))
PRINT I%, A$(Pointer%, 0), A$(Pointer%, 1), Pointer%
DisplayCount% = DisplayCount% + 1
IF DisplayCount% > ScreenLimit% THEN
CALL Waiter
DisplayCount% = 0
END IF
NEXT I%
END IF
CALL Waiter
RETURN
SorryFull:
PRINT "Sorry, but there is no space available in the array."
PRINT "Try saving your data, stopping this program, resizing"; CHR$(34); "ArraySize%"; CHR$(34); ","
PRINT "reloading the saved data, and then retry this load."
RETURN
SUB GetData (Key$, Index%, SeekCount%, SaveIndex%)
' Try to get the index to the record that that contains Key$ as it's key
' Key$ - the value are looking for
' Found% - did we find Key$ - True/False returned
' Index% - a pointer to where Key$ was found
' SeekCount% - how many tries it took us to fing Key$
' SaveIndex% - the pointer to the first deleted value we found, if any
Index% = Hash(Key$) 'start the search
SaveIndex% = -1
SeekCount% = 1
IF A$(Index%, 0) <> "" AND A$(Index%, 0) <> Key$ THEN
'if data in entry, and not a match, do a retry
ReHashCount% = 0
DO WHILE SeekCount% < RetryLimit% AND A$(Index%, 0) <> "" AND A$(Index%, 0) <> Key$
IF A$(Index%, 0) = DeletedValue$ AND SaveIndex% = -1 THEN
'if this is the first deleted value, save it for data insertion
SaveIndex% = Index%
END IF
Index% = Index% + PowersOfTwo%(ReHashCount%)
DO WHILE Index% > ArraySize%
Index% = Index% - ArraySize%
LOOP
ReHashCount% = ReHashCount% + 1
IF ReHashCount% > PowerMax% THEN
ReHashCount% = 0
END IF
SeekCount% = SeekCount% + 1
LOOP
END IF
END SUB
FUNCTION Hash (TestString$)
' turn TestString into a number in the range of 0 - ArraySize%
' the function can be tailored to suit the users needs
Trial = 0
FOR I% = 1 TO LEN(TestString$)
Trial = Trial + ASC(MID$(TestString$, I%, 1))
NEXT I%
Hash = (Trial * Trial) MOD ArraySize%
END FUNCTION
SUB Waiter
' wait for a keypress, then return to caller
PRINT "Press (almost) any key to continue..."
K$ = ""
DO WHILE K$ = ""
K$ = INKEY$
LOOP
END SUB
FUNCTION WhackIt$ (InputString$)
'whack the input string -
' strip leading and trailing spaces,
' make the remainder upper case, and
' make it a single letter response.
TestString$ = UCASE$(RTRIM$(LTRIM$(InputString$)))
IF LEN(TestString$) > 1 THEN
TestString$ = LEFT$(TestString$, 1)
END IF
WhackIt$ = TestString$
END FUNCTION